home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / modes / outl-mouse.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  19.5 KB  |  618 lines
  1. ;;; outl-mouse.el --- outline mode mouse commands for Emacs
  2.  
  3. ;; Copyright 1994 (C) Andy Piper <ajp@eng.cam.ac.uk>
  4. ;; Keywords: outlines, mouse
  5.  
  6. ;; This file is part of XEmacs.
  7.  
  8. ;; XEmacs is free software; you can redistribute it and/or modify it
  9. ;; under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; XEmacs is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. ;; General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  20. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21. ;;
  22. ;; outl-mouse.el v1.3.8:
  23. ;;
  24. ;; Defines button one to hide  blocks when clicked on outline-up-arrow
  25. ;; and expand blocks when clicked on outline-down-arrow.  Features are
  26. ;; activated   when   outline-minor-mode  or   outline-mode are turned
  27. ;; on. There is also a menu for each glyph on button 3. 
  28. ;;
  29. ;; To use put:
  30. ;;     (require 'outl-mouse)
  31. ;; in your .emacs file.
  32. ;;
  33. ;; If you use func-menu all  the time and  want outl-mouse on all  the
  34. ;; time as well then put:
  35. ;;    (setq outline-sync-with-func-menu t)
  36. ;; outlining will then be turned on when func-menu is. Note that this
  37. ;; requires a patch to func-menu 2.16 (in 19.10) to work:
  38. ;;
  39. ;RCS file: func-menu.el,v
  40. ;retrieving revision 1.1
  41. ;diff -r1.1 func-menu.el
  42. ;180a181,183
  43. ;> (defvar fume-found-function-hook nil
  44. ;>   "*Hook to call after every function match.")
  45. ;> 
  46. ;1137,1138c1140,1142
  47. ;<         (if (listp funcname)
  48. ;<             (setq funclist (cons funcname funclist)))
  49. ;---
  50. ;>         (cond ((listp funcname)
  51. ;>              (setq funclist (cons funcname funclist))
  52. ;>              (save-excursion (run-hooks 'fume-found-function-hook))))
  53. ;;
  54. ;; If you  want mac-style outlining  then set  outline-mac-style to t.
  55. ;; If you   want    the  outline   arrows on    the    left then   set
  56. ;; outline-glyphs-on-left  to t. If you  have xpm then arrows are much
  57. ;; better defined.
  58. ;;
  59. ;; This package uses func-menu to  define outline regexps if they  are
  60. ;; not already defined. You should no longer need to use out-xtra.
  61. ;;
  62. ;; You can define the package to  do something other than outlining by
  63. ;; setting outline-fold-in-function and outline-fold-out-function.
  64. ;;
  65. ;; You can define the color of outline arrows, but only in your .emacs.
  66. ;;
  67. ;; Only works in XEmacs 19.10 and onwards. 
  68. ;;
  69. ;; User definable variables.
  70. ;;
  71. (defvar outline-mac-style nil
  72.   "*If t then outline glyphs will be right and down arrows.")
  73.  
  74. (defvar outline-glyphs-on-left nil
  75.   "*The position of outline glyphs on a line.")
  76.  
  77. (defvar outline-glyph-colour "Gray75"
  78.   "*The colour of outlining arrows.")
  79.  
  80. (defvar outline-glyph-shade-colour "Gray40"
  81.   "*The shadow colour of outlining arrows.")
  82.  
  83. (defvar outline-glyph-lit-colour "Gray90"
  84.   "*The lit colour of outlining arrows.")
  85.  
  86. (defvar outline-fold-in-function 'outline-fold-in
  87.   "Function to call for folding in. 
  88. The function should take an annotation argument.")
  89. (make-variable-buffer-local 'outline-fold-in-function)
  90.  
  91. (defvar outline-fold-out-function 'outline-fold-out
  92.   "Function to call for folding out. 
  93. The function should take an annotation argument.")
  94. (make-variable-buffer-local 'outline-fold-out-function)
  95.  
  96. (defvar outline-sync-with-func-menu nil
  97.   "*If t then outline glyphs are permanently added by func-menu scans.
  98. If outline-minor-mode is  turned off then  turing it back on will have
  99. no  effect. Instead the  buffer  should be rescanned from the function
  100. menu.")
  101.  
  102. (defvar outline-move-point-after-click t
  103.   "*If t then point is moved to the current heading when clicked.")
  104.  
  105. (defvar outline-scanning-message "Adding glyphs... (%3d%%)"
  106.   "*Progress message during the scanning of the buffer.
  107. Set this to nil to inhibit progress messages.")
  108.  
  109. ;;
  110. ;; No user definable variables beyond this point.
  111. ;;
  112. (defconst outline-up-arrow
  113.   (make-pixmap    ; an up-arrow
  114.    (if (featurep 'xpm)
  115.        (concat "/* XPM */
  116. static char * arrow[] = {
  117. \"10 10 5 1\",
  118. \"     c none\",
  119. \".    c " outline-glyph-lit-colour "\",
  120. \"X    c " outline-glyph-shade-colour "\",
  121. \"o    c " outline-glyph-colour "\",
  122. \"O    c " outline-glyph-shade-colour "\",
  123. \"    .X    \",
  124. \"    .X    \",
  125. \"   ..XX   \",
  126. \"   ..XX   \",
  127. \"  ..ooXX  \",
  128. \"  ..ooXX  \",
  129. \" ..ooooXX \",
  130. \" ..ooooXX \",
  131. \"..OOOOOOXX\",
  132. \"OOOOOOOOOO\"};")
  133.      (list 10 10 (concat "\000\000\000\000\060\000\060\000\150\000"
  134.              "\150\000\324\000\324\000\376\001\376\001"))))
  135.   "Bitmap object for outline up glyph.")
  136.  
  137. (defconst outline-up-arrow-mask
  138.   (make-pixmap    ; an up-arrow
  139.    (if (featurep 'xpm)
  140.        (concat "/* XPM */
  141. static char * arrow[] = {
  142. \"10 10 5 1\",
  143. \"     c none\",
  144. \".    c " outline-glyph-shade-colour "\",
  145. \"X    c " outline-glyph-lit-colour "\",
  146. \"o    c " outline-glyph-colour "\",
  147. \"O    c " outline-glyph-lit-colour "\",
  148. \"    .X    \",
  149. \"    .X    \",
  150. \"   ..XX   \",
  151. \"   ..XX   \",
  152. \"  ..ooXX  \",
  153. \"  ..ooXX  \",
  154. \" ..ooooXX \",
  155. \" ..ooooXX \",
  156. \"..OOOOOOXX\",
  157. \"OOOOOOOOOO\"};")
  158.      (list 10 10 (concat "\000\000\000\000\060\000\060\000\130\000"
  159.              "\130\000\254\000\274\000\006\001\376\001"))))
  160.   "Bitmap object for outline depressed up glyph.")
  161.  
  162. (defconst outline-down-arrow
  163.   (make-pixmap    ; a down-arrow
  164.    (if (featurep 'xpm)
  165.        (concat "/* XPM */
  166. static char * down[] = {
  167. \"10 10 5 1\",
  168. \"     c " outline-glyph-lit-colour "\",
  169. \".    c " outline-glyph-lit-colour "\",
  170. \"X    c " outline-glyph-shade-colour "\",
  171. \"o    c none\",
  172. \"O    c " outline-glyph-colour "\",
  173. \"          \",
  174. \"..      XX\",
  175. \"o..OOOOXXo\",
  176. \"o..OOOOXXo\",
  177. \"oo..OOXXoo\",
  178. \"oo..OOXXoo\",
  179. \"ooo..XXooo\",
  180. \"ooo..XXooo\",
  181. \"oooo.Xoooo\",
  182. \"oooo.Xoooo\"};")
  183.      (list 10 10 (concat "\000\000\000\000\376\001\202\001\364\000"
  184.              "\324\000\150\000\150\000\060\000\060\000"))))
  185.   "Bitmap object for outline down glyph.")
  186.  
  187. (defconst outline-down-arrow-mask
  188.   (make-pixmap    ; a down-arrow
  189.    (if (featurep 'xpm)
  190.        (concat "/* XPM */
  191. static char * down[] = {
  192. \"10 10 5 1\",
  193. \"     c " outline-glyph-shade-colour "\",
  194. \".    c " outline-glyph-shade-colour "\",
  195. \"X    c " outline-glyph-lit-colour "\",
  196. \"o    c none\",
  197. \"O    c " outline-glyph-colour "\",
  198. \"          \",
  199. \"..      XX\",
  200. \"o..OOOOXXo\",
  201. \"o..OOOOXXo\",
  202. \"oo..OOXXoo\",
  203. \"oo..OOXXoo\",
  204. \"ooo..XXooo\",
  205. \"ooo..XXooo\",
  206. \"oooo.Xoooo\",
  207. \"oooo.Xoooo\"};")
  208.    (list 10 10 (concat "\000\000\000\000\376\001\376\001\254\000"
  209.                "\254\000\130\000\130\000\060\000\060\000"))))
  210.   "Bitmap object for outline depressed down glyph.")
  211.  
  212. (defconst outline-right-arrow
  213.   (make-pixmap    ; a right-arrow
  214.    (if (featurep 'xpm)
  215.        (concat "/* XPM */
  216. static char * right[] = {
  217. \"10 10 5 1\",
  218. \"     c " outline-glyph-lit-colour "\",
  219. \".    c " outline-glyph-lit-colour "\",
  220. \"X    c none\",
  221. \"o    c " outline-glyph-colour "\",
  222. \"O    c " outline-glyph-shade-colour "\",
  223. \" .XXXXXXXX\",
  224. \" ...XXXXXX\",
  225. \"  ....XXXX\",
  226. \"  oo....XX\",
  227. \"  oooo....\",
  228. \"  ooooOOOO\",
  229. \"  ooOOOOXX\",
  230. \"  OOOOXXXX\",
  231. \" OOOXXXXXX\",
  232. \" OXXXXXXXX\"};")
  233.    (list 10 10 (concat "\000\000\006\000\032\000\142\000\232\001"
  234.                "\352\001\172\000\036\000\006\000\000\000"))))
  235.   "Bitmap object for outline right glyph.")
  236.  
  237. (defconst outline-right-arrow-mask
  238.   (make-pixmap    ; a right-arrow
  239.    (if (featurep 'xpm)
  240.        (concat "/* XPM */
  241. static char * right[] = {
  242. \"10 10 5 1\",
  243. \"     c " outline-glyph-shade-colour "\",
  244. \".    c " outline-glyph-shade-colour "\",
  245. \"X    c none\",
  246. \"o    c " outline-glyph-colour "\",
  247. \"O    c " outline-glyph-lit-colour "\",
  248. \" .XXXXXXXX\",
  249. \" ...XXXXXX\",
  250. \"  ....XXXX\",
  251. \"  oo....XX\",
  252. \"  oooo....\",
  253. \"  ooooOOOO\",
  254. \"  ooOOOOXX\",
  255. \"  OOOOXXXX\",
  256. \" OOOXXXXXX\",
  257. \" OXXXXXXXX\"};")
  258.    (list 10 10 (concat "\000\000\006\000\036\000\176\000\346\001"
  259.                "\236\001\146\000\036\000\006\000\000\000"))))
  260.   "Bitmap object for outline depressed right glyph.")
  261.  
  262. (defvar outline-glyph-menu
  263.   '("Outline Commands"
  264.     ["Hide all"        hide-body            t]
  265.     ["Hide all subtrees" hide-subtrees-same-level    t]
  266.     "---"
  267.     ["Hide subtree"    hide-subtree                    t]
  268.     ["Hide body"        hide-body                       t]
  269.     ["Show subtree"    show-subtree                    t]
  270.     ["Show body"        show-entry                      t]
  271.     "---"
  272.     ["Update buffer"    outline-add-glyphs        t]
  273.     ["Rescan buffer"    outline-rescan-buffer        t])
  274.   "Menu of commands for outline glyphs.")
  275.  
  276. (set-pixmap-contributes-to-line-height outline-down-arrow nil)
  277. (set-pixmap-contributes-to-line-height outline-up-arrow nil)
  278. (set-pixmap-contributes-to-line-height outline-down-arrow-mask nil)
  279. (set-pixmap-contributes-to-line-height outline-up-arrow-mask nil)
  280. (set-pixmap-contributes-to-line-height outline-right-arrow nil)
  281. (set-pixmap-contributes-to-line-height outline-right-arrow-mask nil)
  282.  
  283. (require 'annotations)
  284. (require 'advice)            ; help me doctor !
  285. (require 'outline)
  286. (require 'func-menu)            ; for those most excellent regexps.
  287.  
  288. (add-hook 'outline-mode-hook 'outline-mouse-hooks)
  289. (add-hook 'outline-minor-mode-hook 'outline-mouse-hooks)
  290. ;; I thought this was done already ...
  291. (make-variable-buffer-local 'outline-regexp)
  292. (make-variable-buffer-local 'outline-level)
  293.  
  294. (cond (outline-sync-with-func-menu
  295.        (add-hook 'fume-found-function-hook 'outline-heading-add-glyph-1)
  296.        (setq-default fume-rescan-buffer-hook '(lambda () 
  297.                         (outline-minor-mode 1)))))
  298.  
  299. (defadvice fume-set-defaults (after fume-set-defaults-ad activate)
  300.   "Advise fume-set-defaults to setup outline regexps."
  301.   (if (and (not (assq 'outline-regexp (buffer-local-variables)))
  302.        fume-function-name-regexp)
  303.       (progn
  304.     (setq outline-regexp (if (listp fume-function-name-regexp)
  305.                  (car fume-function-name-regexp)
  306.                    fume-function-name-regexp))
  307.     (setq outline-level '(lambda () 1)))))
  308.  
  309. (defadvice outline-minor-mode (after outline-mode-mouse activate)
  310.   "Advise outline-minor-mode to delete glyphs when switched off."
  311.   (if (not outline-minor-mode)
  312.       (progn 
  313.     (outline-delete-glyphs)
  314.     (show-all))))
  315.  
  316. ;; advise all outline commands so that glyphs are synced after use
  317. (defadvice show-all (after show-all-ad activate)
  318.   "Advise show-all to sync headings."
  319.   (outline-sync-visible-sub-headings-in-region (point-min) (point-max)))
  320.  
  321. (defadvice hide-subtree (after hide-subtree-ad activate)
  322.   "Advise hide-subtree to sync headings."
  323.   (outline-sync-visible-sub-headings))
  324.  
  325. (defadvice hide-entry (after hide-entry-ad activate)
  326.   "Advise hide-entry to sync headings."
  327.   (outline-sync-visible-sub-headings))
  328.  
  329. (defadvice hide-body (after hide-body-ad activate)
  330.   "Advise hide-body to sync headings."
  331.   (outline-sync-visible-sub-headings-in-region (point-min) (point-max)))
  332.  
  333. (defadvice show-subtree (after show-subtree-ad activate)
  334.   "Advise show-subtree to sync headings."
  335.   (outline-sync-visible-sub-headings))
  336.  
  337. (defadvice show-entry (after show-entry-ad activate)
  338.   "Advise shown-entry to sync headings."
  339.   (outline-sync-visible-sub-headings))
  340.  
  341. ;;;###autoload
  342. (defun outl-mouse-mode ()
  343.   "Calls outline-mode, with outl-mouse extensions"
  344.   (interactive)
  345.   (outline-mode))
  346.     
  347. ;;;###autoload
  348. (defun outl-mouse-minor-mode (&optional arg)
  349.   "Toggles outline-minor-mode, with outl-mouse extensions"
  350.   (interactive "P")
  351.   (outline-minor-mode arg))
  352.  
  353. (defun hide-subtrees-same-level ()
  354.   "Hide all subtrees below the current level."
  355.   (interactive)
  356.   (save-excursion
  357.     (while (progn
  358.          (hide-subtree)
  359.                (condition-case nil
  360.          (progn
  361.            (outline-forward-same-level 1)
  362.            t)
  363.            (error nil))))))
  364.  
  365. (defun outline-mouse-hooks ()
  366.   "Hook for installing outlining with the mouse."
  367.   ;; use function menu regexps if not set
  368.   (fume-set-defaults)
  369.   ;; only add glyphs when we're not synced.
  370.   (if (not outline-sync-with-func-menu) (outline-add-glyphs))
  371.   ;; add C-a to local keymap
  372.   (let ((outline (cond ((keymapp (lookup-key (current-local-map)
  373.                          outline-minor-mode-prefix))
  374.             (lookup-key (current-local-map)
  375.                     outline-minor-mode-prefix))
  376.                (t
  377.             (define-key (current-local-map)
  378.               outline-minor-mode-prefix (make-sparse-keymap))
  379.             (lookup-key (current-local-map) 
  380.                     outline-minor-mode-prefix)))))
  381.     (define-key outline "\C-a" 'outline-heading-add-glyph)
  382.     (define-key outline-mode-map "\C-c\C-a" 'outline-heading-add-glyph)))
  383.  
  384. (defun outline-add-glyphs ()
  385.   "Add annotations and glyphs to all heading lines that don't have them."
  386.   (interactive)
  387.   (save-excursion
  388.     (and outline-scanning-message (message outline-scanning-message 0))
  389.     (goto-char (point-min))
  390.     (if (not (outline-on-heading-p)) (outline-next-visible-heading-safe))
  391.     (while 
  392.     (progn
  393.       (outline-heading-add-glyph-1)
  394.       (and outline-scanning-message 
  395.            (message outline-scanning-message (fume-relative-position)))
  396.       (outline-next-visible-heading-safe)))
  397.     (and outline-scanning-message 
  398.      (message "%s done" (format outline-scanning-message 100)))))
  399.  
  400. (defun outline-delete-glyphs ()
  401.   "Remove annotations and glyphs from heading lines."
  402.   (save-excursion
  403.     (mapcar 'outline-heading-delete-glyph (annotation-list))))
  404.  
  405. (defun outline-rescan-buffer ()
  406.   "Remove and insert all annotations."
  407.   (interactive)
  408.   (outline-delete-glyphs)
  409.   (outline-add-glyphs)
  410.   (save-excursion
  411.     (outline-sync-visible-sub-headings-in-region (point-min) (point-max))))
  412.  
  413. (defun outline-heading-delete-glyph (ext)
  414.   "Delete annotation and glyph from a heading with annotation EXT."
  415.   (if (and 
  416.        (progn
  417.      (goto-char (extent-start-position ext))
  418.      (beginning-of-line)
  419.      (outline-on-heading-p))
  420.        (extent-property ext 'outline))
  421.       (delete-annotation ext))
  422.   nil)
  423.  
  424. (defun outline-heading-add-glyph ()
  425.   "Interactive version of outline-heading-add-glyph-1."
  426.   (interactive)
  427.   (save-excursion
  428.     (outline-heading-add-glyph-1)))
  429.  
  430. (defun outline-heading-add-glyph-1 ()
  431.   "Add glyph to the end of heading line which point is on.
  432.  Returns nil if point is not on a heading or glyph already exists."
  433.   (if (or (not (outline-on-heading-p))
  434.       (outline-heading-has-glyph-p)
  435.       (save-excursion (forward-line) (outline-on-heading-p)))
  436.       nil
  437.     (outline-back-to-heading)
  438.     (let ((anot2 
  439.        (make-annotation (if outline-mac-style 
  440.                 outline-right-arrow
  441.                   outline-down-arrow)
  442.                 (save-excursion (if outline-glyphs-on-left nil
  443.                           (outline-end-of-heading))
  444.                         (point))
  445.                 'text nil t 
  446.                 (if outline-mac-style
  447.                 outline-right-arrow-mask
  448.                   outline-down-arrow-mask)))
  449.       (anot1 
  450.        (make-annotation (if outline-mac-style
  451.                 outline-down-arrow
  452.                   outline-up-arrow)
  453.                 (save-excursion (if outline-glyphs-on-left nil
  454.                           (outline-end-of-heading))
  455.                         (point))
  456.                 'text nil t 
  457.                 (if outline-mac-style
  458.                 outline-down-arrow-mask
  459.                   outline-up-arrow-mask))))
  460.       ;; we cunningly make the annotation data point to its twin.
  461.       (set-annotation-data anot1 anot2)
  462.       (set-extent-property anot1 'outline 'up)
  463.       (set-annotation-action anot1 'outline-up-click)
  464.       (set-annotation-menu anot1 outline-glyph-menu)
  465.       (set-extent-priority anot1 1)
  466.       (set-annotation-data anot2 anot1)
  467.       (set-extent-property anot2 'outline 'down)
  468.       (set-annotation-menu anot2 outline-glyph-menu)
  469.       (set-annotation-action anot2 'outline-down-click)
  470.       (annotation-hide anot2))
  471.     t))
  472.  
  473. (defun outline-heading-has-glyph-p ()
  474.   "Return t if heading has an outline glyph."
  475.   (catch 'found
  476.     (mapcar
  477.      '(lambda(a)
  478.     (if (extent-property a 'outline)
  479.         (throw 'found t)))
  480.      (annotations-in-region (save-excursion (outline-back-to-heading) (point))
  481.                 (save-excursion (outline-end-of-heading) 
  482.                         (+ 1 (point)))
  483.                 (current-buffer)))
  484.     nil))
  485.  
  486. (defun outline-sync-visible-sub-headings-in-region (pmin pmax)
  487.   "Make sure all anotations on headings in region PMIN PMAX are 
  488. displayed correctly."
  489.   (mapcar '(lambda (x) 
  490.          (goto-char (extent-start-position x))
  491.          (beginning-of-line)
  492.          (cond ((and (eq (extent-property x 'outline) 'down)
  493.              ;; skip things we can't see
  494.              (not (eq (preceding-char) ?\^M)))
  495.             (if (outline-more-to-hide)
  496.             ;; reveal my twin
  497.             (annotation-reveal (annotation-data x))
  498.               (annotation-hide (annotation-data x)))
  499.             (if (not (outline-hidden-p))
  500.             ;; hide my self
  501.             (annotation-hide x)
  502.               (annotation-reveal x)))))
  503.       (annotations-in-region pmin pmax (current-buffer))))
  504.  
  505. (defun outline-sync-visible-sub-headings ()
  506.   "Make sure all anotations on sub-headings below the one point is on are 
  507. displayed correctly."
  508.   (outline-sync-visible-sub-headings-in-region 
  509.    (point) 
  510.    (progn (outline-end-of-subtree) (point))))
  511.  
  512. (defun outline-fold-out (annotation)
  513.   "Fold out the current heading."
  514.   (beginning-of-line)
  515. ;  (if (not (equal (condition-case nil
  516. ;              (save-excursion (outline-next-visible-heading 1)
  517. ;                      (point))
  518. ;            (error nil))
  519. ;          (save-excursion (outline-next-heading) 
  520. ;                  (if (eobp) nil (point)))))
  521.   (if (save-excursion (outline-next-heading) 
  522.               (eq (preceding-char) ?\^M))
  523.       (progn 
  524.     (save-excursion (show-children))
  525.     (outline-sync-visible-sub-headings))
  526.     ;; mess with single entry
  527.     (if (outline-hidden-p) 
  528.     (progn 
  529.       (save-excursion (show-entry))
  530.       ;; reveal my twin and hide me
  531.       (annotation-hide annotation)
  532.       (annotation-reveal (annotation-data annotation))))))
  533.  
  534. (defun outline-fold-in (annotation)
  535.   "Fold in the current heading."
  536.   (beginning-of-line)
  537.   ;; mess with single entries
  538.   (if (not (outline-hidden-p))
  539.       (progn
  540.     (save-excursion (hide-entry))
  541.     (if (not (outline-more-to-hide))
  542.         (annotation-hide annotation))
  543.     (annotation-reveal (annotation-data annotation)))
  544.     ;; otherwise look for more leaves
  545.     (save-excursion 
  546.       (if (outline-more-to-hide t)
  547.       (hide-subtree)
  548.     (hide-leaves)))
  549.     ;; sync everything
  550.     (outline-sync-visible-sub-headings)))
  551.  
  552. (defun outline-more-to-hide (&optional arg)
  553.   "Return t if there are more visible sub-headings or text.
  554. With ARG return t only if visible sub-headings have no visible text."
  555.   (if (not (outline-hidden-p))
  556.       (if arg nil t)
  557.     (save-excursion
  558.       (and (< (funcall outline-level) (condition-case nil
  559.                       (progn 
  560.                         (outline-next-visible-heading 1)
  561.                         (funcall outline-level))
  562.                     (error 0)))
  563.        (if (and (not (outline-hidden-p)) arg)
  564.            nil t)))))
  565.  
  566. (defun outline-hidden-p ()
  567.   "Return t if point is on the header of a hidden subtree."
  568.   (save-excursion
  569.     (let ((end-of-entry (save-excursion (outline-next-heading))))
  570.       ;; Make sure that the end of the entry really exists.
  571.       (if (not end-of-entry)
  572.       (setq end-of-entry (point-max)))
  573.       (outline-back-to-heading)
  574.       ;; If there are ANY ^M's, the entry is hidden.
  575.       (search-forward "\^M" end-of-entry t))))
  576.  
  577. (defun outline-next-visible-heading-safe ()
  578.   "Safely go to the next visible heading. 
  579. nil is returned if there is none."
  580.   (condition-case nil
  581.       (progn
  582.     (outline-next-visible-heading 1)
  583.     t)
  584.     (error nil)))
  585.  
  586. (defun outline-up-click (data ev)
  587.   "Annotation action for clicking on an up arrow.
  588. DATA is the annotation data. EV is the mouse click event."
  589.   (save-excursion
  590.     (goto-char (extent-end-position (event-glyph-extent ev)))
  591.     (funcall outline-fold-in-function (event-glyph-extent ev)))
  592.   (if outline-move-point-after-click
  593.       (progn
  594.     (goto-char (extent-end-position (event-glyph-extent ev)))
  595.     (beginning-of-line))))
  596. ; This line demonstrates a bug in redisplay
  597. (defun outline-down-click (data ev)
  598.   "Annotation action for clicking on a down arrow.
  599. DATA is the annotation data. EV is the mouse click event."
  600.   (save-excursion
  601.     (goto-char (extent-end-position (event-glyph-extent ev)))
  602.     (funcall outline-fold-out-function (event-glyph-extent ev)))
  603.   (if outline-move-point-after-click
  604.       (progn
  605.     (goto-char (extent-end-position (event-glyph-extent ev)))
  606.     (beginning-of-line))))
  607.  
  608.  
  609. (provide 'outl-mouse)
  610. (provide 'outln-18)            ; fool auctex - outline is ok now.
  611.  
  612. ;; Local Variables:
  613. ;; outline-regexp: ";;; \\|(def.."
  614. ;; End:
  615.  
  616.  
  617.  
  618.